home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog6.arj / ERRMSG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  2.4 KB  |  103 lines
  1. { errmsg.pas -- Display error messages from a string table }
  2.  
  3. program ErrMsg;
  4.  
  5. {$R errmsg.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects, Strings;
  8.  
  9. const
  10.  
  11.   id_Menu  = 100;    { Menu resource ID }
  12.   cm_Op    = 101;    { Command IDs }
  13.   cm_Quit  = 102;
  14.  
  15.   maxErrorNumber = 6;    { Top error number in string table }
  16.  
  17. type
  18.  
  19.   ErrMsgApplication = object(TApplication)
  20.     procedure InitMainWindow; virtual;
  21.   end;
  22.  
  23.   PErrMsgWindow = ^ErrMsgWindow;
  24.   ErrMsgWindow = object(TWindow)
  25.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  26.     procedure CMOp(var Msg: TMessage);
  27.       virtual cm_First + cm_Op;
  28.     procedure CMQuit(var Msg: TMessage);
  29.       virtual cm_First + cm_Quit;
  30.   end;
  31.  
  32.  
  33. { ErrMsgApplication }
  34.  
  35. {- Initialize ErrMsgApplication object's window }
  36. procedure ErrMsgApplication.InitMainWindow;
  37. begin
  38.   MainWindow := New(PErrMsgWindow, Init(nil, 'ErrMsg'))
  39. end;
  40.  
  41.  
  42. { ErrMsgWindow }
  43.  
  44. {- Construct ErrMsgWindow object }
  45. constructor ErrMsgWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  46. begin
  47.   TWindow.Init(AParent, ATitle);
  48.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
  49. end;
  50.  
  51. {- Display error message; return true to cancel failed operation }
  52. function ErrorCancel(HWindow: HWnd; ErrNum: Word): Boolean;
  53. var
  54.   S3: String[3];
  55.   ErrCap: array[0 .. 11] of Char;
  56.   ErrStr: array[0 .. 63] of Char;
  57. begin
  58.   Str(ErrNum, S3);
  59.   StrPCopy(ErrCap, 'Error #:' + S3);
  60.   if LoadString(HInstance, ErrNum, ErrStr, 63) > 0 then
  61.     ErrorCancel :=
  62.       MessageBox(HWindow, ErrStr, ErrCap,
  63.         mb_IconStop or mb_RetryCancel) = idCancel
  64.   else
  65.     ErrorCancel := true
  66. end;
  67.  
  68. {- Execute pseudo operation }
  69. procedure ErrMsgWindow.CMOp(var Msg: TMessage);
  70. var
  71.   ErrNum: Word;
  72.   Canceled: Boolean;
  73. begin
  74.   Canceled := true;   { Present "done" flag }
  75.   repeat
  76.     ErrNum := 1 + Random(maxErrorNumber);  { Simulate error }
  77.     if ErrNum <> 0 then
  78.       Canceled := ErrorCancel(HWindow, ErrNum)
  79.   until Canceled
  80. end;
  81.  
  82. {- Exit program }
  83. procedure ErrMsgWindow.CMQuit(var Msg: TMessage);
  84. begin
  85.   CloseWindow
  86. end;
  87.  
  88. var
  89.  
  90.   ErrMsgApp: ErrMsgApplication;
  91.  
  92. begin
  93.   ErrMsgApp.Init('ErrMsgApp');
  94.   ErrMsgApp.Run;
  95.   ErrMsgApp.Done
  96. end.
  97.  
  98.  
  99. {--------------------------------------------------------------
  100.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  101.   Revision 1.00    Date: 4/16/1991
  102. ---------------------------------------------------------------}
  103.